(DEFPROP BBFCNS
 (BBFCNS ALPHABETIC
	 ALPHANUM
	 BBARGS
	 BBCOND
	 BBELSE
	 BBEX
	 BBEXL
	 BBFUN
	 BBFUNCTION
	 BBFUNDEF
	 BBINIT
	 BBLAMBDA
	 BBLAMBDAF
	 BBLIST
	 BBLISTF
	 BBLPT
	 BBPPROP
	 BBPPROPS
	 BBPROG
	 BBPROGA
	 BBPROPS
	 BBPUB
	 BBQUOTE
	 BBQUOTEL
	 BBSELECTA
	 BBSELECTQ
	 BBTTY
	 BBTTYLPT
	 BBVALDEF
	 BBVARS
	 BBXGP
	 BBXGPPUB
	 BINOPB
	 BRACKET
	 CARLIST
	 CHARW
	 CHVAL
	 CLEARBB
	 CLEARBITS
	 CLEARFONTS
	 FIN
	 FONT
	 FSIZE
	 HIN
	 INOPB
	 INOPBB
	 INPUNA
	 LABL
	 LCASE
	 LINL
	 MAK
	 MAXF
	 NEWLINE
	 PARENS
	 PRA
	 PREH
	 PREX
	 PRF
	 PRINDEC
	 PRINFONTFILE
	 PRINTC
	 PRINX
	 PRINXX
	 PRT
	 PSIZE
	 READFONT
	 SCANPOP
	 SCANPUSH
	 SCANTABLE
	 SETBITS
	 SETCARLIST
	 SETSCANTABLE
	 SETSLASHES
	 SETUPFONT
	 SIMPLEPRINT
	 SIN
	 SLASHIFY
	 SMALL
	 SMALLNAM
	 SUMLEN
	 TTYMSG
	 ULINE
	 UNOP
	 VALIDPUBCODES
	 XA
	 XBLANK
	 XBOLD
	 XCONST
	 XGP
	 XGPLINL
	 XSPACE
	 XSYM
	 XVAR)
VALUE)

(DEFPROP ALPHABETIC
 (LAMBDA (V) (AND (GREATERP V 100) (LESSP V 133)))
EXPR)

(DEFPROP ALPHANUM
 (LAMBDA(U)
  (OR (NULL U)
      (AND (OR (NUMBERP (CAR U)) (ALPHABETIC (CHRVAL (CAR U))))
	   (ALPHANUM (CDR U)))))
EXPR)

(DEFPROP BBARGS
 (LAMBDA (U) (MAPCAR (FUNCTION BBEX) U))
EXPR)

(DEFPROP BBCOND
 (LAMBDA(U)
  (CONS
   12
   (COND
    ((NULL U) (MAK (QUOTE X) (LIST (XVAR NIL))))
    (T
     (MAK
      (QUOTE E)
      (CONS
       (MAK
	(QUOTE T)
	(LIST
	 (MAK
	  (QUOTE B)
	  (LIST (MAK (QUOTE X) (LIST (XBOLD (QUOTE if)) (XBLANK)))
		(BRACKET (BBEX (CAAR U)) 12)))
	 (MAK
	  (QUOTE B)
	  (LIST
	   (MAK (QUOTE X)
		(LIST (XBLANK) (XBOLD (QUOTE then)) (XBLANK)))
	   (BRACKET (BBEXL (CDAR U)) 12)))))
       (BBELSE (CDR U))))))))
EXPR)

(DEFPROP BBELSE
 (LAMBDA(U)
  (COND
   ((NULL U) NIL)
   ((EQ (CAAR U) (QUOTE T))
    (LIST
     (MAK (QUOTE B)
	  (LIST
	   (MAK	(QUOTE X)
		(LIST (XBLANK) (XBOLD (QUOTE else)) (XBLANK)))
	   (BRACKET (BBEXL (CDAR U)) 5)))))
   (T
    (CONS
     (MAK (QUOTE T)
	  (LIST
	   (MAK	(QUOTE B)
		(LIST
		 (MAK (QUOTE X)
		      (LIST (XBLANK)
			    (XBOLD (QUOTE else/ if))
			    (XBLANK)))
		 (BRACKET (BBEX (CAAR U)) 12)))
	   (MAK	(QUOTE B)
		(LIST
		 (MAK (QUOTE X)
		      (LIST (XBLANK) (XBOLD (QUOTE then)) (XBLANK)))
		 (BRACKET (BBEXL (CDAR U)) 12)))))
     (BBELSE (CDR U))))))
EXPR)

(DEFPROP BBEX
 (LAMBDA(E)
  (COND	((ATOM E) (CONS 144 (MAK (QUOTE X) (LIST (XVAR E)))))
	((ATOM (CAR E))
	 ((LAMBDA(U)
	   (COND ((NULL U) (BBFUN (CAR E) (BBARGS (CDR E))))
		 ((NULL (CDR U)) ((CAR U) (CDR E)))
		 (T ((CAR U) (CDR E) (CDR U)))))
	  (GET (CAR E) (QUOTE CARBB))))
	((EQ (CAAR E) (QUOTE LAMBDA))
	 (BBLAMBDA (CDAR E) (BBARGS (CDR E))))
	(T (BBFUN (QUOTE APPLY$) (BBARGS E)))))
EXPR)

(DEFPROP BBEXL
 (LAMBDA(U)
  (COND	((NULL U) (BBEX (QUOTE ****)))
	((NULL (CDR U)) (BBEX (CAR U)))
	(T
	 (CONS 5
	       (MAK (QUOTE E)
		    (INPUNA
		     (MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ ))))
		     (BBARGS U)))))))
EXPR)

(DEFPROP BBFUN
 (LAMBDA(FN ARGS)
  (CONS
   132
   (COND
    ((NULL ARGS)
     (MAK (QUOTE X) (LIST (XVAR FN) (XSYM (QUOTE /[/])))))
    ((NULL (CDR ARGS))
     (MAK
      (QUOTE F)
      (LIST (MAK (QUOTE X) (LIST (XVAR FN) (XBLANK))) (CDAR ARGS))))
    (T
     (MAK
      (QUOTE F)
      (LIST
       (MAK (QUOTE X) (LIST (XVAR FN) (XSYM (QUOTE /[))))
       (MAK
	(QUOTE A)
	(LIST
	 (MAK
	  (QUOTE E)
	  (INPUNA (MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ )))) ARGS))
	 (MAK (QUOTE X) (LIST (XSYM (QUOTE /]))))))))))))
EXPR)

(DEFPROP BBFUNCTION
 (LAMBDA (E) (BBEX (CAR E)))
EXPR)

(DEFPROP BBFUNDEF
 (LAMBDA(NAME ARGS BODY PROP)
  (MAK (QUOTE F)
       (LIST (MAK (QUOTE A)
		  (LIST	(CDR (BBFUN NAME (BBARGS ARGS)))
			(MAK (QUOTE X)
			     (COND ((EQ PROP (QUOTE EXPR))
				    (LIST (XBLANK)
					  (XSYM (QUOTE ←/ ))))
				   (T
				    (LIST (XBLANK)
					  (XSYM (QUOTE /())
					  (XCONST (QUOTE FEXPR))
					  (XSYM
					   (QUOTE /)/ ←/ ))))))))
	     (BRACKET (BBEXL BODY) 5))))
EXPR)

(DEFPROP BBINIT
 (LAMBDA(L)
  (COND
   ((OR (NULL (ERRSET BBNAME NIL)) (NULL BBNAME))
    (NILL DSKIN)
    (SETQ FONTARRAYS NIL)
    (SETQ FONTSYMBOLS NIL)
    (SETQ FONTPROPS NIL)
    (SETQ CARBBLIST NIL)))
  (SETQ BBNAME (CAR L))
  (CLEARBB))
FEXPR)

(DEFPROP BBLAMBDA
 (LAMBDA(U ARGS)
  (CONS	144
	(MAK (QUOTE T)
	     (LIST (PARENS (MAK (QUOTE X) (LIST (XSYM (QUOTE {))))
			   (MAK (QUOTE X) (LIST (XSYM (QUOTE }))))
			   ARGS)
		   (CDR (BBLAMBDAF U))))))
EXPR)

(DEFPROP BBLAMBDAF
 (LAMBDA(U)
  (CONS
   144
   (MAK	(QUOTE F)
	(LIST
	 (MAK (QUOTE B)
	      (LIST
	       (MAK (QUOTE X) (LIST (XSYM (QUOTE /[λ))))
	       (MAK (QUOTE A)
		    (LIST
		     (BBVARS (CAR U))
		     (MAK (QUOTE X) (LIST (XSYM (QUOTE /./ ))))))))
	 (MAK (QUOTE A)
	      (LIST (BRACKET (BBEXL (CDR U)) 5)
		    (MAK (QUOTE X) (LIST (XSYM (QUOTE /]))))))))))
EXPR)

(DEFPROP BBLIST
 (BBLIST (CONS BINOPB 24 (BBSYM / ) (BBSYM /.) (BBSYM / ))
	 (APPEND BINOPB 12 (BBSYM / ) (BBSYM *) (BBSYM / ))
	 (COND BBCOND)
	 (QUOTE BBQUOTE)
	 (OR BINOPB 24 (BBSYM / ) (BBSYM ∨) (BBSYM / ))
	 (AND BINOPB 24 (BBSYM / ) (BBSYM ∧/ ))
	 (LIST BBLISTF)
	 (LAMBDA BBLAMBDAF)
	 (FUNCTION BBFUNCTION)
	 (PLUS BINOPB 40 (BBSYM / ) (BBSYM +) (BBSYM / ))
	 (GREATERP BINOPB 30 (BBSYM / ) (BBSYM >) (BBSYM / ))
	 (LESSP BINOPB 30 (BBSYM / ) (BBSYM <) (BBSYM / ))
	 (PROG BBPROG)
	 (NULL UNOP 132 (BBBOLD n/ ))
	 (MINUS UNOP 132 (BBSYM -))
	 (CAR UNOP 132 (BBBOLD a/ ))
	 (CDR UNOP 132 (BBBOLD d/ ))
	 (CADR UNOP 132 (BBBOLD ad/ ))
	 (CDAR UNOP 132 (BBBOLD da/ ))
	 (CDDR UNOP 132 (BBBOLD dd/ ))
	 (CAAR UNOP 132 (BBBOLD aa/ ))
	 (CAAAR UNOP 132 (BBBOLD aaa/ ))
	 (CAADR UNOP 132 (BBBOLD aad/ ))
	 (CADAR UNOP 132 (BBBOLD ada/ ))
	 (CADDR UNOP 132 (BBBOLD add/ ))
	 (CDAAR UNOP 132 (BBBOLD daa/ ))
	 (CDADR UNOP 132 (BBBOLD dad/ ))
	 (CDDAR UNOP 132 (BBBOLD dda/ ))
	 (CDDDR UNOP 132 (BBBOLD ddd/ ))
	 (CAAAAR UNOP 132 (BBBOLD aaaa/ ))
	 (CAAADR UNOP 132 (BBBOLD aaad/ ))
	 (CAADAR UNOP 132 (BBBOLD aada/ ))
	 (CAADDR UNOP 132 (BBBOLD aadd/ ))
	 (CADAAR UNOP 132 (BBBOLD adaa/ ))
	 (CADADR UNOP 132 (BBBOLD adad/ ))
	 (CADDAR UNOP 132 (BBBOLD adda/ ))
	 (CADDDR UNOP 132 (BBBOLD addd/ ))
	 (CDAAAR UNOP 132 (BBBOLD daaa/ ))
	 (CDAADR UNOP 132 (BBBOLD daad/ ))
	 (CDADAR UNOP 132 (BBBOLD dada/ ))
	 (CDADDR UNOP 132 (BBBOLD dadd/ ))
	 (CDDAAR UNOP 132 (BBBOLD ddaa/ ))
	 (CDDADR UNOP 132 (BBBOLD ddad/ ))
	 (CDDDAR UNOP 132 (BBBOLD ddda/ ))
	 (CDDDDR UNOP 132 (BBBOLD dddd/ ))
	 (ATOM UNOP 132 (BBBOLD at/ ))
	 (EQ BINOPB 30 (BBSYM / ) (BBBOLD eq/ ))
	 (MEMBER BINOPB 30 (BBSYM / ) (BBSYM ε/ ))
	 (NOT UNOP 132 (BBSYM ¬))
	 (DIFFERENCE BINOPB 40 (BBSYM / ) (BBSYM -/ ))
	 (SETQ BINOPB 20 (BBSYM / ) (BBSYM ←/ ))
	 (SELECTQ BBSELECTQ))
VALUE)

(DEFPROP BBLISTF
 (LAMBDA(U)
  (CONS	144
	(PARENS	(MAK (QUOTE X) (LIST (XSYM (QUOTE <))))
		(MAK (QUOTE X) (LIST (XSYM (QUOTE >))))
		(BBARGS U))))
EXPR)

(DEFPROP BBLPT
 (LAMBDA (U) (SETQ LINL 160) (BBTTYLPT U))
EXPR)

(DEFPROP BBPPROP
 (LAMBDA(ATM PROP V)
  (COND	((NULL V) NIL)
	(T (TTYMSG ATM)
	   (TERPRI)
	   (TERPRI)
	   (NEWLINE (COND (XGP 60) (T 3)))
	   (PREX (COND ((NULL PROP) (CDR (BBEX V)))
		       ((EQ PROP (QUOTE VALUE))
			(BBVALDEF ATM (CDR V)))
		       (T (BBFUNDEF ATM (CADR V) (CDDR V) PROP)))
		 0
		 0)
	   (TERPRI))))
EXPR)

(DEFPROP BBPPROPS
 (LAMBDA(V)
  (COND	((ATOM V)
	 (MAPC (FUNCTION (LAMBDA (X) (BBPPROP V X (GET V X))))
	       BBPROPS))
	(T (BBPPROP NIL NIL V))))
EXPR)

(DEFPROP BBPROG
 (LAMBDA(U)
  (CONS	12
	(MAK (QUOTE B)
	     (LIST (MAK	(QUOTE X)
			(LIST (XBOLD (QUOTE prog)) (XBLANK)))
		   (CONS 10000
			 (CONS (QUOTE E)
			       (CONS (BRACKET
				      (CONS 0 (BBVARS (CAR U)))
				      0)
				     (BBPROGA (CDR U)))))))))
EXPR)

(DEFPROP BBPROGA
 (LAMBDA(U)
  (COND	((NULL U) NIL)
	((ATOM (CAR U))
	 (COND ((NULL (CDR U))
		(LIST (MAK (QUOTE U) (LIST (LABL (CAR U))))))
	       (T
		(CONS (MAK (QUOTE U)
			   (LIST (LABL (CAR U))
				 (CDR (BBEX (CADR U)))))
		      (BBPROGA (CDDR U))))))
	(T (CONS (CDR (BBEX (CAR U))) (BBPROGA (CDR U))))))
EXPR)

(DEFPROP BBPROPS
 (BBPROPS EXPR FEXPR)
VALUE)

(DEFPROP BBPUB
 (LAMBDA(U)
  (PROG	NIL
	(SETQ SELECTCHAR (QUOTE %))
	(SETQ PUB T)
	(SETSLASHES (QUOTE (∂ { % //)))
	(PRINTC (QUOTE /.DEVICE/ XGP))
	(MAPC (FUNCTION
	       (LAMBDA(W)
		(PRINTC (QUOTE /.FONT/ ))
		(PRINC (CAR W))
		(PRINC (QUOTE / /"))
		(PRINFONTFILE (CDDR W))
		(PRINC (QUOTE /"))))
	      PUBFONTS)
	(PRINTC (QUOTE /.EVENLEFTBORDER←ODDLEFTBORDER←1000))
	(PRINTC (QUOTE /.PAGE/ FRAME/ 52/ HIGH/ 83/ WIDE;))
	(PRINTC (QUOTE /.AREA/ TEXT/ LINES/ 4/ TO/ 50;))
	(PRINTC (QUOTE /.TITLE/ AREA/ HEADING/ LINES/ 1/ TO/ 3;))
	(PRINTC (QUOTE /.PLACE/ TEXT;))
	(PRINTC (QUOTE /.EVERY/ HEADING/(/,/,{PAGE}/);))
	(PRINTC (QUOTE /.BEGIN/ NOFILL))
	(PRINTC (QUOTE /.VARIABLE/ CHW))
	(PRINTC (QUOTE /.CHW/ ←/ CHARW))
	(PRINTC (QUOTE /.TURN/ OFF/ /"βα#\←∞↑↓∪/"))
	(PRINTC (QUOTE /.TURN/ ON/ /"∂{%/"))
	(PRINTC (QUOTE /.TURN/ ON/ /"///"/ FOR/ /"α/"))
	(PRINTC
	 (QUOTE
	  /.AT/ /"∂∂/(/"/ CH/ /"/)/"/ ⊂/ CHARW←CH}∂/(2/){CHARW←CHW/ ⊃→
))	(BBXGPPUB U)
	(PRINTC (QUOTE /.END))
	(SCANPUSH)))
EXPR)

(DEFPROP BBQUOTE
 (LAMBDA(E)
  (CONS
   144
   (COND
    ((ATOM (CAR E))
     (MAK (QUOTE X)
	  (COND
	   ((OR	(NUMBERP (CAR E))
		(AND (ALPHABETIC (CHRVAL (CAR E)))
		     (ALPHANUM (CDR (EXPLODEC (CAR E))))))
	    (LIST (XCONST (CAR E))))
	   ((STRINGP (CAR E))
	    (COND
	     (PUB (LIST (XCONST (CAR E))))
	     (T
	      (LIST (XSYM (QUOTE /"))
		    (XCONST (CAR E))
		    (XSYM (QUOTE /"))))))
	   (T
	    (LIST (XBLANK)
		  (XSYM (QUOTE `))
		  (XCONST (CAR E))
		  (XSYM (QUOTE '/ )))))))
    (T
     (MAK (QUOTE B)
	  (LIST
	   (MAK (QUOTE X) (LIST (XSYM (QUOTE /())))
	   (MAK	(QUOTE A)
		(LIST
		 (MAK (QUOTE E) (BBQUOTEL (CAR E)))
		 (MAK (QUOTE X) (LIST (XSYM (QUOTE /)))))))))))))
EXPR)

(DEFPROP BBQUOTEL
 (LAMBDA(E)
  (COND	((NULL (CDR E)) (LIST (CDR (BBQUOTE E))))
	((ATOM (CDR E))
	 (LIST (CDR (BBQUOTE E))
	       (MAK (QUOTE B)
		    (LIST (MAK (QUOTE X)
			       (LIST (XBLANK) (XSYM (QUOTE /./ ))))
			  (CDR (BBQUOTE (LIST (CDR E))))))))
	(T
	 (CONS (MAK (QUOTE A)
		    (LIST (CDR (BBQUOTE E))
			  (MAK (QUOTE X) (LIST (XBLANK)))))
	       (BBQUOTEL (CDR E))))))
EXPR)

(DEFPROP BBSELECTA
 (LAMBDA(U)
  (COND
   ((NULL (CDR U)) (LIST (BBEX (CAR U))))
   (T
    (CONS
     (CONS
      0
      (MAK (QUOTE B)
	   (LIST
	    (MAK (QUOTE A)
		 (LIST (CDR (BBQUOTE (CAR U)))
		       (MAK (QUOTE X) (LIST (XBLANK)))))
	    (BRACKET (BBEXL (CDAR U)) 5))))
     (BBSELECTA (CDR U))))))
EXPR)

(DEFPROP BBSELECTQ
 (LAMBDA(U)
  (COND	((LESSP (LENGTH U) 3) (BBFUN (QUOTE SELECTQ) (BBARGS U)))
	(T
	 (BBFUN	(QUOTE SELECTQ)
		(CONS (BBEX (CAR U)) (BBSELECTA (CDR U)))))))
EXPR)

(DEFPROP BBTTY
 (LAMBDA (U) (SETQ LINL 105) (BBTTYLPT U))
EXPR)

(DEFPROP BBTTYLPT
 (LAMBDA(U)
  (LINELENGTH LINL)
  (SETQ SINDENT SIN)
  (SETQ FINDENT FIN)
  (SETQ HINDENT HIN)
  (SETQ FMAX MAXF)
  (COND
   (XGP
    (MAPC (FUNCTION (LAMBDA (W) (REMPROP (CAR W) (CDR W))))
	  FONTPROPS)))
  (SETQ XGP NIL)
  (SETQ PUB NIL)
  (MAPC (FUNCTION BBPPROPS) U)
  (LINELENGTH 105)
  NIL)
EXPR)

(DEFPROP BBVALDEF
 (LAMBDA(NAME VAL)
  (CDR (BBEX (LIST (QUOTE SETQ) NAME (LIST (QUOTE QUOTE) VAL)))))
EXPR)

(DEFPROP BBVARS
 (LAMBDA(U)
  (MAK (QUOTE E)
       (INPUNA
	(MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ ))))
	(MAPCAR
	 (FUNCTION
	  (LAMBDA (V) (CONS 144 (MAK (QUOTE X) (LIST (XVAR V))))))
	 U))))
EXPR)

(DEFPROP BBXGP
 (LAMBDA(U)
  (SETQ SELECTCHAR (MAKNAM (LIST (QUOTE //) (ASCII 177) (QUOTE ↓))))
  (SETQ	FONTSYMS
	(LIST (QUOTE 1)
	      (QUOTE 2)
	      (QUOTE 3)
	      (QUOTE 4)
	      (QUOTE 5)
	      (QUOTE 6)
	      (QUOTE 7)
	      (QUOTE 8)
	      (QUOTE 9)
	      (QUOTE A)
	      (QUOTE B)
	      (QUOTE C)
	      (QUOTE D)
	      (QUOTE E)
	      (QUOTE F)))
  (SETQ PUB NIL)
  (BBXGPPUB U)
  NIL)
EXPR)

(DEFPROP BBXGPPUB
 (LAMBDA(U)
  (SETQ LINL XGPLINL)
  (LINELENGTH 10000)
  (SETQ SINDENT (TIMES SIN CHARW))
  (SETQ FINDENT (TIMES FIN CHARW))
  (SETQ HINDENT (TIMES HIN CHARW))
  (SETQ FMAX (TIMES MAXF CHARW))
  (SETQ CURFONT NIL)
  (COND
   ((NOT XGP)
    (MAPC (FUNCTION (LAMBDA (W) (REMPROP (CAR W) (CDR W))))
	  FONTPROPS)))
  (SETQ XGP T)
  (MAPC (FUNCTION BBPPROPS) U)
  (LINELENGTH 105))
EXPR)

(DEFPROP BINOPB
 (LAMBDA(ARGS V)
  (CONS	(CAR V)
	(MAK (QUOTE E)
	     (INOPB
	      (MAK (QUOTE X)
		   (MAPCAR
		    (FUNCTION (LAMBDA (W) (XA (CAR W) (CADR W))))
		    (CDR V)))
	      (BBARGS ARGS)
	      (CAR V)))))
EXPR)

(DEFPROP BRACKET
 (LAMBDA(U PREC)
  (COND	((NOT (GREATERP (CAR U) PREC))
	 (MAK (QUOTE B)
	      (LIST (MAK (QUOTE X) (LIST (XSYM (QUOTE /[))))
		    (MAK (QUOTE A)
			 (LIST (CDR U)
			       (MAK (QUOTE X)
				    (LIST (XSYM (QUOTE /])))))))))
	(T (CDR U))))
EXPR)

(DEFPROP CARLIST
 (LAMBDA (L) (SETCARLIST L))
FEXPR)

(DEFPROP CHARW
 (CHARW . 20)
VALUE)

(DEFPROP CHVAL
 (LAMBDA (Z) (COND ((NUMBERP Z) (PLUS Z 60)) (T (CHRVAL Z))))
EXPR)

(DEFPROP CLEARBB
 (LAMBDA NIL
  (CLEARFONTS)
  (MAPC	(FUNCTION (LAMBDA (W) (REMPROP (CAR W) (QUOTE CARBB))))
	CARBBLIST)
  (SETQ CARBBLIST NIL))
EXPR)

(DEFPROP CLEARBITS
 (LAMBDA (N M) (BOOLE 2 M N))
EXPR)

(DEFPROP CLEARFONTS
 (LAMBDA NIL
  (SETQ XGP NIL)
  (SETQ PUBFONTS NIL)
  (SETQ FONTLIST NIL)
  (SETQ LCFONTS NIL)
  (SETQ XGPFONT 0)
  (SETQ FREEFONTARRAYS FONTARRAYS)
  (MAPC (FUNCTION (LAMBDA (V) (REMPROP V (QUOTE FONT)))) FONTSYMBOLS)
  (SETQ FONTSYMBOLS NIL)
  (MAPC (FUNCTION (LAMBDA (W) (REMPROP (CAR W) (CDR W)))) FONTPROPS)
  (SETQ FONTPROPS NIL))
EXPR)

(DEFPROP FIN
 (FIN . 2)
VALUE)

(DEFPROP FONT
 (LAMBDA (L) (SETUPFONT (CAR L) (CADR L) (CDDR L)) (CAR L))
FEXPR)

(DEFPROP FSIZE
 (LAMBDA(AT WIDTHS)
  (COND (XGP (PSIZE (EXPLODEC AT) WIDTHS)) (T (FLATSIZEC AT))))
EXPR)

(DEFPROP HIN
 (HIN . 2)
VALUE)

(DEFPROP INOPB
 (LAMBDA(P U PREC)
  (COND	((NULL U) NIL)
	(T (CONS (BRACKET (CAR U) PREC) (INOPBB P (CDR U) PREC)))))
EXPR)

(DEFPROP INOPBB
 (LAMBDA(P U PREC)
  (COND	((NULL U) NIL)
	(T
	 (CONS (MAK (QUOTE B) (LIST P (BRACKET (CAR U) PREC)))
	       (INOPBB P (CDR U) PREC)))))
EXPR)

(DEFPROP INPUNA
 (LAMBDA(P U)
  (COND	((NULL U) NIL)
	((NULL (CDR U)) (NCONS (CDAR U)))
	(T
	 (CONS (MAK (QUOTE A) (LIST (CDAR U) P))
	       (INPUNA P (CDR U))))))
EXPR)

(DEFPROP LABL
 (LAMBDA (U) (MAK (QUOTE X) (LIST (XVAR U) (XBLANK))))
EXPR)

(DEFPROP LCASE
 (LAMBDA(L)
  (SETQ	LCFONTS
	(APPEND
	 LCFONTS
	 (MAPCAR
	  (FUNCTION
	   (LAMBDA(W)
	    (READLIST (APPEND (QUOTE (B B)) (EXPLODE W)))))
	  L)))
  L)
FEXPR)

(DEFPROP LINL
 (LINL . 105)
VALUE)

(DEFPROP MAK
 (LAMBDA (A U) (CONS (SUMLEN U) (CONS A U)))
EXPR)

(DEFPROP MAXF
 (MAXF . 10)
VALUE)

(DEFPROP NEWLINE
 (LAMBDA(N)
  (COND	(PUB (TERPRI)
	     (SETQ IND N)
	     (SETQ POS IND)
	     (PRINC (QUOTE ∂∂))
	     (PRINDEC (LIST N)))
	(XGP
	 (PROG NIL
	       (TERPRI)
	       (SETQ IND N)
	       (SETQ POS 0)
	  A    (COND ((EQ POS IND) (RETURN NIL))
		     ((LESSP (DIFFERENCE IND POS) 100)
		      (XSPACE (DIFFERENCE IND POS))
		      (SETQ POS IND)
		      (RETURN NIL))
		     (T (XSPACE 77)))
	       (SETQ POS (PLUS POS 77))
	       (GO A)))
	(T
	 (PROG NIL
	       (TERPRI)
	       (SETQ IND N)
	       (SETQ POS 0)
	  A    (COND ((EQ POS IND) (RETURN NIL)))
	       (PRINC (QUOTE / ))
	       (SETQ POS (ADD1 POS))
	       (GO A)))))
EXPR)

(DEFPROP PARENS
 (LAMBDA(LEFT RIGHT ARGS)
  (MAK (QUOTE B)
       (LIST LEFT
	     (MAK (QUOTE A)
		  (LIST	(MAK (QUOTE E)
			     (INPUNA
			      (MAK (QUOTE X)
				   (LIST (XSYM (QUOTE /,/ ))))
			      ARGS))
			RIGHT)))))
EXPR)

(DEFPROP PRA
 (LAMBDA(E IM R)
  (PREX (CADDR E) IM (PLUS R (CAAR (CDDDR E))))
  (PREX (CADDDR E) IM R))
EXPR)

(DEFPROP PREH
 (LAMBDA(E IM R I2)
  (PROG	(IB IMM)
	(SETQ IB (MAX I2 IM))
	(SETQ IMM (PLUS IB SINDENT))
	(SETQ E (CDDR E))
	(COND ((NULL E) (RETURN NIL)))
   A	(PREX (CAR E) IMM (COND ((NULL (CDR E)) R) (T 0)))
	(SETQ E (CDR E))
	(COND ((NULL E) (RETURN NIL))
	      (T (ULINE IB (CAR E)) (GO A)))))
EXPR)

(DEFPROP PREX
 (LAMBDA(E IM R)
  (COND	((NOT (GREATERP (PLUS (CAR E) POS R) LINL)) (SIMPLEPRINT E))
	(T
	 (SELECTQ (CADR E)
		  (E (PREH E IM R POS))
		  (H (PREH E IM R (PLUS POS HINDENT)))
		  (A (PRA E IM R))
		  ((B U) (PRF E IM R LINL))
		  (F (PRF E IM R FMAX))
		  (T (PRT E IM R))
		  (PRINX E)))))
EXPR)

(DEFPROP PRF
 (LAMBDA(E IM R M)
  (COND	((OR (GREATERP (PLUS (CAADDR E) POS (MINUS IND)) M)
	     (GREATERP (PLUS (CAADDR E) POS) LINL))
	 (PROG (I)
	       (SETQ I (MAX IM (PLUS IND FINDENT)))
	       (PREX (CADDR E) (PLUS I SINDENT) 0)
	       (NEWLINE I)
	       (PREX (CADDDR E) I R)))
	(T (PREX (CADDR E) 0 0) (PREX (CADDDR E) IM R))))
EXPR)

(DEFPROP PRINDEC
 (LAMBDA(U)
  (PROG	(B P)
	(SETQ B BASE)
	(SETQ P *NOPOINT)
	(SETQ BASE 12)
	(SETQ *NOPOINT T)
	(PRINC U)
	(SETQ BASE B)
	(SETQ *NOPOINT P)))
EXPR)

(DEFPROP PRINFONTFILE
 (LAMBDA(FILE)
  (PRINC (CAADR FILE))
  (COND
   ((NOT (EQ (CDADR FILE) (QUOTE FNT)))
    (PRINC (QUOTE /.))
    (PRINC (CDADR FILE))))
  (COND
   ((NOT (EQUAL (CAR FILE) (QUOTE (XGP SYS))))
    (PRINC (QUOTE /[))
    (PRINC (CAAR FILE))
    (PRINC (QUOTE /,))
    (PRINC (CADAR FILE))
    (PRINC (QUOTE /])))))
EXPR)

(DEFPROP PRINTC
 (LAMBDA (U) (TERPRI) (PRINC U))
EXPR)

(DEFPROP PRINX
 (LAMBDA (E) (MAPC (FUNCTION PRINXX) (CDDR E)))
EXPR)

(DEFPROP PRINXX
 (LAMBDA(E)
  (COND	((AND (EQ POS IND) (EQ (CDDR E) (QUOTE / ))) NIL)
	(T (COND (XGP (COND
		       ((NOT (EQ CURFONT (CADR E)))
			(SETQ CURFONT (CADR E))
			(PRINC SELECTCHAR)
			(PRINC CURFONT)))
		      (COND (PUB (PRIN1 (CDDR E)))
			    (T (PRINC (CDDR E)))))
		 (T (PRINC (CDDR E))))
	   (SETQ POS (PLUS POS (CAR E))))))
EXPR)

(DEFPROP PRT
 (LAMBDA(E IM R)
  ((LAMBDA(I)
    (COND ((NOT
	    (GREATERP (PLUS (CAADDR E) (CAADDR (CADDDR E)) POS)
		      LINL))
	   (PREX (CADDR E) 0 0)
	   (PREX (CADDR (CADDDR E)) 0 0)
	   (NEWLINE I)
	   (PREX (CADDDR (CADDDR E)) I R))
	  (T (PREX (CADDR E) (PLUS I SINDENT) 0)
	     (NEWLINE I)
	     (PREX (CADDDR E) (PLUS I SINDENT) R))))
   (MAX IM (PLUS IND HINDENT))))
EXPR)

(DEFPROP PSIZE
 (LAMBDA(U WIDTHS)
  (COND	((NULL U) 0)
	(T (PLUS (WIDTHS (CHVAL (CAR U))) (PSIZE (CDR U) WIDTHS)))))
EXPR)

(DEFPROP READFONT
 (LAMBDA(FILE)
  (PROG	(A B)
	(COND ((NULL FREEFONTARRAYS)
	       (SETQ A (GENSYM))
	       (EVAL (LIST (QUOTE ARRAY) A 22 200))
	       (SETQ FONTARRAYS (CONS A FONTARRAYS)))
	      (T (SETQ A (CAR FREEFONTARRAYS))
		 (SETQ FREEFONTARRAYS (CDR FREEFONTARRAYS))))
	(EVAL (CONS (QUOTE INPUT) (CONS (QUOTE FCH) FILE)))
	(INC (QUOTE FCH) NIL)
	(SETQ B 0)
   L1	(EVAL
	 (LIST (QUOTE STORE) (LIST A B) (LSH (MAKNUM (WORDIN)) -22)))
	(SETQ B (ADD1 B))
	(COND ((LESSP B 200) (GO L1)))
	(INC NIL T)
	(RETURN A)))
EXPR)

(DEFPROP SCANPOP
 (LAMBDA NIL (SETSCANTABLE PROGSCAN))
EXPR)

(DEFPROP SCANPUSH
 (LAMBDA NIL (SETSCANTABLE LISPSCAN))
EXPR)

(DEFPROP SCANTABLE
 (LAMBDA NIL
  (PROG	(N TBL)
	(SETQ N 200)
	(SETQ TBL NIL)
   L	(SETQ N (SUB1 N))
	(SETQ TBL (CONS (MODCHR N NIL) TBL))
	(COND ((GREATERP N 0) (GO L)))
	(RETURN TBL)))
EXPR)

(DEFPROP SETBITS
 (LAMBDA (N M) (BOOLE 7 N M))
EXPR)

(DEFPROP SETCARLIST
 (LAMBDA(U)
  (SETQ CARBBLIST U)
  (MAPC	(FUNCTION
	 (LAMBDA (W) (PUTPROP (CAR W) (CDR W) (QUOTE CARBB))))
	U))
EXPR)

(DEFPROP SETSCANTABLE
 (LAMBDA(U)
  (PROG	(N)
	(SETQ N 0)
   L	(MODCHR N (CAR U))
	(SETQ N (ADD1 N))
	(SETQ U (CDR U))
	(COND (U (GO L)))))
EXPR)

(DEFPROP SETSLASHES
 (LAMBDA(U)
  (SETQ LISPSCAN (SCANTABLE))
  (SLASHIFY (MAPCAR (FUNCTION CHRVAL) U))
  (SETQ PROGSCAN (SCANTABLE))
  (SETQ %SCANSETFLAG% (GET (QUOTE SCANPUSH) (QUOTE SUBR))))
EXPR)

(DEFPROP SETUPFONT
 (LAMBDA(SYMBOL PUBCODE FILE)
  (PROG	(A B)
	(SETQ SYMBOL
	      (READLIST (APPEND (QUOTE (B B)) (EXPLODE SYMBOL))))
	(COND
	 ((MEMBER SYMBOL FONTSYMBOLS)
	  (ERROR (QUOTE "FONT SYMBOL DEFINED TWICE")))
	 (T (SETQ FONTSYMBOLS (CONS SYMBOL FONTSYMBOLS))))
	(COND
	 ((NOT (NULL FILE))
	  (COND
	   ((NULL (CDR FILE))
	    (SETQ FILE (CONS (QUOTE (XGP SYS)) FILE))))
	  (COND
	   ((ATOM (CADR FILE))
	    (SETQ
	     FILE
	     (LIST (CAR FILE) (CONS (CADR FILE) (QUOTE FNT))))))))
	(COND
	 ((AND (NUMBERP PUBCODE)
	       (LESSP PUBCODE 12)
	       (GREATERP PUBCODE 0))
	  (SETQ PUBCODE (INTERN (ASCII (PLUS PUBCODE 60))))))
	(COND
	 ((NOT (MEMBER PUBCODE VALIDPUBCODES))
	  (ERROR (QUOTE "INVALID PUB CODE")))
	 ((SETQ A (ASSOC PUBCODE PUBFONTS))
	  (COND
	   ((OR (NULL FILE) (EQUAL FILE (CDDR A)))
	    (PUTPROP
	     SYMBOL
	     (CONS (CDR (ASSOC# (CDDR A) FONTLIST))
		   (CONS PUBCODE (CADR A)))
	     (QUOTE FONT)))
	   (T (PRINT (CDDR A))
	      (PRINT FILE)
	      (ERROR "TWO FONT FILES FOR SAME PUBCODE"))))
	 ((NULL FILE)
	  (ERROR (QUOTE "NO FILE SPECIFIED WHEN REQUIRED")))
	 (T (SETQ A (ASSOC# FILE FONTLIST))
	    (COND
	     ((NULL A) (SETQ B (READFONT FILE))
		       (SETQ FONTLIST (CONS (CONS FILE B) FONTLIST)))
	     (T (SETQ B (CDR A))))
	    (SETQ
	     PUBFONTS
	     (CONS
	      (CONS
	       PUBCODE
	       (CONS (INTERN (ASCII (SETQ XGPFONT (ADD1 XGPFONT))))
		     FILE))
	      PUBFONTS))
	    (PUTPROP SYMBOL
		     (CONS B (CONS PUBCODE (CADAR PUBFONTS)))
		     (QUOTE FONT))))
	(RETURN SYMBOL)))
EXPR)

(DEFPROP SIMPLEPRINT
 (LAMBDA(E)
  (COND	((EQ (CADR E) (QUOTE X)) (PRINX E))
	(T (MAPC (FUNCTION SIMPLEPRINT) (CDDR E)))))
EXPR)

(DEFPROP SIN
 (SIN . 1)
VALUE)

(DEFPROP SLASHIFY
 (LAMBDA(U)
  (PROG	(N)
	(SETQ N 0)
   L	(COND ((MEMBER N U)
	       (MODCHR N (CLEARBITS (MODCHR N NIL) -200000000000)))
	      (T (MODCHR N (SETBITS (MODCHR N NIL) -200000000000))))
	(SETQ N (ADD1 N))
	(COND ((LESSP N 200) (GO L)))))
EXPR)

(DEFPROP SMALL
 (LAMBDA(C)
  (COND	((NUMBERP C) C)
	(T
	 ((LAMBDA(X)
	   (COND ((AND (GREATERP X 100) (LESSP X 133))
		  (ASCII (PLUS X 40)))
		 (T C)))
	  (CHRVAL C)))))
EXPR)

(DEFPROP SMALLNAM
 (LAMBDA (E) (MAKNAM (MAPCAR (FUNCTION SMALL) (EXPLODE E))))
EXPR)

(DEFPROP SUMLEN
 (LAMBDA(U)
  (COND ((NULL U) 0) (T (PLUS (CAAR U) (SUMLEN (CDR U))))))
EXPR)

(DEFPROP TTYMSG
 (LAMBDA(MSG)
  (PROG (CH) (SETQ CH (OUTC NIL NIL)) (PRINT MSG) (OUTC CH NIL)))
EXPR)

(DEFPROP ULINE
 (LAMBDA(I E)
  (COND	((EQ (CADR E) (QUOTE U))
	 (NEWLINE (MAX (DIFFERENCE I (CAADDR E)) 0)))
	(T (NEWLINE I))))
EXPR)

(DEFPROP UNOP
 (LAMBDA(ARGS V)
  (CONS	(CAR V)
	(MAK (QUOTE F)
	     (LIST (MAK	(QUOTE X)
			(MAPCAR
			 (FUNCTION
			  (LAMBDA (W) (XA (CAR W) (CADR W))))
			 (CDR V)))
		   (BRACKET (BBEX (CAR ARGS)) 131)))))
EXPR)

(DEFPROP VALIDPUBCODES
 (NIL /1 /2 /3 /4 /5 /6 /7 /8 /9 A B C D E F G)
VALUE)

(DEFPROP XA
 (LAMBDA(SYMB AT)
  (COND	((NUMBERP AT)
	 (PROG (A)
	       (SETQ A (GET SYMB (QUOTE FONT)))
	       (RETURN
		(CONS (FSIZE AT (CAR A))
		      (CONS (COND (PUB (CADR A))
				  (XGP (CDDR A))
				  (T NIL))
			    AT)))))
	((GET AT SYMB))
	(T
	 (PROG (A ATX)
	       (SETQ A (GET SYMB (QUOTE FONT)))
	       (SETQ ATX
		     (COND ((MEMBER SYMB LCFONTS) (SMALLNAM AT))
			   (T AT)))
	       (SETQ FONTPROPS (CONS (CONS AT SYMB) FONTPROPS))
	       (RETURN
		(PUTPROP
		 AT
		 (CONS (FSIZE ATX (CAR A))
		       (CONS (COND (PUB (CADR A))
				   (XGP (CDDR A))
				   (T NIL))
			     ATX))
		 SYMB))))))
EXPR)

(DEFPROP XBLANK
 (LAMBDA NIL (XA (QUOTE BBSYM) (QUOTE / )))
EXPR)

(DEFPROP XBOLD
 (LAMBDA (V) (XA (QUOTE BBBOLD) V))
EXPR)

(DEFPROP XCONST
 (LAMBDA (V) (XA (QUOTE BBCONST) V))
EXPR)

(DEFPROP XGP
 (XGP)
VALUE)

(DEFPROP XGPLINL
 (XGPLINL . 2424)
VALUE)

(DEFPROP XSPACE
 (LAMBDA(N)
  (COND	((EQ N 0) NIL)
	(T (PRINC (ASCII 177)) (PRINC (QUOTE α)) (PRINC (ASCII N)))))
EXPR)

(DEFPROP XSYM
 (LAMBDA (V) (XA (QUOTE BBSYM) V))
EXPR)

(DEFPROP XVAR
 (LAMBDA(E)
  (COND	((OR (NULL E) (EQ E T) (NUMBERP E)) (XCONST E))
	(T (XA (QUOTE BBVAR) E))))
EXPR)